home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / hipsquar / APERTURE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-06-07  |  3.5 KB  |  133 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {     Creating Non-Rectangular Windows                    }
  4. {                                                         }
  5. {     Requires Win32 API (Delphi 2.0 or 3.0 or newer)     }
  6. {                                                         }
  7. {     Copyright ⌐ 1997 Steven J. Colagiovanni             }
  8. {                                                         }
  9. {*********************************************************}
  10.  
  11. unit Aperture;
  12.  
  13. interface
  14.  
  15. uses
  16.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.     ExtCtrls, StdCtrls;
  18.  
  19. type
  20.     TfrmAperture = class(TForm)
  21.         Image1: TImage;
  22.         procedure FormCreate(Sender: TObject);
  23.         procedure FormPaint(Sender: TObject);
  24.         procedure FormKeyDown(Sender: TObject; var Key: Word;
  25.             Shift: TShiftState);
  26.     private
  27.         { Private declarations }
  28.         procedure WMNCHitTest(Var Msg: TMessage); message WM_NCHITTEST;
  29.     public
  30.         { Public declarations }
  31.     end;
  32.  
  33. var
  34.     frmAperture: TfrmAperture;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. var
  41.     RgnPts: array[0..6] of TPoint;        // Outline of hole
  42.     FlmPts: array[0..7] of TPoint;        // Outline of film
  43.  
  44. Const
  45.     rPts: integer = 7;
  46.     fPts: integer = 8;
  47.  
  48. procedure TfrmAperture.WMNCHitTest(Var Msg: TMessage);
  49. begin
  50.     { Respond to left mouse button down, so we can drag window }
  51.     if GetAsyncKeyState(VK_LButton) < 0 then
  52.         Msg.Result := HTCaption
  53.     else
  54.         Msg.Result := HTClient;
  55.  
  56.     { if right mouse button down, close window }
  57.     if GetAsyncKeyState(VK_RButton) < 0 then
  58.         Close;
  59. end;
  60.  
  61. procedure CalcRgnPoints;
  62. begin
  63.     { Create polygon, outlining hole in center of window }
  64.     RgnPts[0] := Point(158, 140);
  65.     RgnPts[1] := Point(174, 124);
  66.     RgnPts[2] := Point(192, 126);
  67.     RgnPts[3] := Point(202, 140);
  68.  
  69.     RgnPts[4] := Point(202, 171);
  70.     RgnPts[5] := Point(174, 178);
  71.     RgnPts[6] := Point(163, 167);
  72.  
  73.     { Create polygon, outlining piece of film }
  74.     FlmPts[0] := Point(0, 148);
  75.     FlmPts[1] := Point(198, 11);
  76.     FlmPts[2] := Point(233, 15);
  77.     FlmPts[3] := Point(253, 0);
  78.  
  79.     FlmPts[4] := Point(259, 0);
  80.     FlmPts[5] := Point(278, 27);
  81.     FlmPts[6] := Point(278, 32);
  82.     FlmPts[7] := Point(37, 201);
  83.  
  84. end;
  85.  
  86. procedure TfrmAperture.FormCreate(Sender: TObject);
  87. var
  88.     Region1, Region2: hRgn;
  89. begin
  90.     CalcRgnPoints;        // Construct Polygon
  91.     { Create first region, the circle }
  92.     Region1 := CreateEllipticRgn(30, 10, ClientWidth, ClientHeight);
  93.     { Create second region, the polygon for the film strip }
  94.     Region2 := CreatePolygonRgn(FlmPts[0], fPts, ALTERNATE);
  95.     { Combine the regions, into one region }
  96.     CombineRgn(Region1, Region1, Region2, RGN_OR);
  97.  
  98.     { Create third region, the hole in the center }
  99.     Region2 := CreatePolygonRgn(RgnPts[0], rPts, ALTERNATE);
  100.     { Create a region that consists of the current region,
  101.         minus the third region (the hole) }
  102.     CombineRgn(Region1, Region1, Region2, RGN_DIFF);
  103.     { Assign the region to the window }
  104.     SetWindowRgn(Handle, Region1, True);
  105.     Repaint;
  106.  
  107.     { Do not delete region - Windows now has control
  108.         of the region. }
  109. end;
  110.  
  111. procedure TfrmAperture.FormPaint(Sender: TObject);
  112. begin
  113.     with canvas do
  114.     begin
  115.         // copy image to window
  116.         Draw(0, 0, Image1.Picture.Bitmap);
  117.         Brush.Style := bsClear;
  118.  
  119.         { Outline circle for better visibility }
  120.         Pen.Color := clBlack;
  121.         Pen.Width := 2;
  122.         Ellipse(31, 11, width-1, height-1);
  123.     end;
  124. end;
  125.  
  126. procedure TfrmAperture.FormKeyDown(Sender: TObject; var Key: Word;
  127.     Shift: TShiftState);
  128. begin
  129.     if key = VK_Escape then Close;
  130. end;
  131.  
  132. end.
  133.